The PC-SIG Library 10/The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso/PC_SIGCD/10/9/DISK1095.ZIP/LINKSKL.PRG

Text File | 1986-10-06 | 11KB | 344 lines

* LINKSKL
* SKELETON FOR FILE MAINTENANCE SCREEN WHICH LINKS TO A LINE FILE
* SUPPORTS HIERARCHICAL FILE STRUCTURES: HEADER-LINE, PARENT-CHILD, ETC.
* FILE STRUCTURE MUST ALREADY EXIST
SET HEADING OFF
SET SAFETY OFF
SET STATUS OFF
CLEAR
CLEAR ALL
SET TALK OFF
SET BELL OFF
* DEFINE A STRING OF BLANKS
STORE SPACE(80) TO BLANK
* CLEAR REQUEST AND ACTION CONTROL VARIABLES
STORE " " TO REQUEST
STORE " " TO ACTION
*
*===============================START MODS: 1================================*
* SET NAME OF PRIMARY (PARENT) FILE                                          *
STORE "filename" TO FILENAME
* SET NAME OF SECONDARY (CHILD) FILE
STORE "linkname" TO LINKNAME
* SETUP COUNT OF INDEXES FOR THE FILE filename
STORE 2 TO IXCOUNT
* SETUP CONSTANTS CONTAINING INDEXES IN SEQUENCE TO USE IN MACRO LATER.
* LIST EACH INDEX FIRST AS A PRIMARY INDEX. VARIABLES NAMED IXA, IXB, IXC, ETC.
STORE "index1,index2" TO IXA
* DEFINE KEYS FOR INDEX. IF NUMERIC, MUST CONVERT WITH STR(). USE DI+IXA, ETC.
STORE "field1" TO DIIXA
STORE "index2,index1" TO IXB
STORE "STR(field2,10,2)" TO DIIXB
* DEFINE KEY WHICH LINKS PARENT AND CHILD RECORDS DEFINED IN TERMS OF PARENT
* FILE FIELDS.
STORE "P.field1" TO DIPARENT
* DEFINE CORRESPONDING KEY IN TERMS OF PARENT RECORD FIELDS
* CHILD FILE INDEXING ONLY POSSIBLE IN PRESENCE OF PARENT
STORE "P.field1" TO DILINK
* SETUP NAME OF INDEX FILE FOR THE LINKED FILE. MUST NOT BE SAME NAME AS A
* PARENT FILE INDEX
STORE "linkindex" TO IXLINK
*==================================END MODS==================================*
*
* SAVE NAME OF MACRO WHICH CONTAINS ACTIVE INDEX AS FIRST INDEX
STORE "IXA" TO LIVE_IX
* GET RECORD COUNTS
USE &FILENAME
COUNT TO RECCNT
USE &LINKNAME
COUNT TO LINKCNT
STORE "N" TO DATAIN
* IF FILE IS EMPTY, ASSUME INDEXES NOT CREATED AND CREATE THEM
SELECT A
IF RECCNT=0 .AND. IXCOUNT>0
   STORE 1 TO COUNT
   DO WHILE COUNT<=IXCOUNT
      STORE "IX"+CHR(64+COUNT) TO TEMP
      STORE "DI"+TEMP TO TEMP2
      IF IXCOUNT>1
         STORE SUBSTR(&TEMP,1,AT(",",&TEMP)-1) TO TEMP
      ELSE
         STORE &TEMP TO TEMP
      ENDIF
      STORE &TEMP2 TO TEMP2
      INDEX ON &TEMP2 TO &TEMP
      STORE COUNT+1 TO COUNT
   ENDDO
ENDIF
* ADD INDEXES
SET INDEX TO &IXA
* POSITION AT FIRST RECORD IN LIVE INDEX SEQUENCE FOR INITIAL DISPLAY
GO TOP
* IF LINK FILE IS EMPTY, ASSUME INDEX NOT CREATED AND CREATE IT
SELECT B
   INDEX ON &DILINK TO &IXLINK
* ADD INDEX FOR LINKED FILE
SET INDEX TO &IXLINK
* POSITION LINKED FILE AT FIRST CHILD RECORD MATCHING KEY IN PARENT
SEEK DIPARENT
*
* MAIN UPDATE LOOP. TERMINATED BY 'M' AS REQUEST
DO WHILE REQUEST<>"M"
*  CLEAR RECORD DISPLAY AREA. TO SAVE TIME, COULD CLEAR ONLY LINES WITH
*  FIELDS FROM CHILD FILE
   STORE 1 TO COUNT
   DO WHILE COUNT<19
      @ COUNT,0 SAY BLANK
      STORE COUNT+1 TO COUNT
   ENDDO
*
*===============================START MODS: 2================================*
* DISPLAY SCREEN MASK: HEADING INFORMATION PLUS LABELS FOR EACH FIELD        *
   @ 1,22 SAY "SMITH'S BIKEWORKS INFORMATION SYSTEM"
   @ 3,11 SAY ">> ??????????????? System File Maintenance <<"
   @ 5,17 SAY "Today's Date:"
   ?? DATE()
* SETUP VARIABLE PART OF MASK
   SELECT A
* ALL FOLLOWING FIELDS ARE FROM PARENT FILE
   @ 7,1  SAY "Field No 1 " GET P.field1
   @ 9,1  SAY "Field No 2 " GET P.field2
   @ 11,1 SAY "Field No 3 " GET P.field3
*============================================================================
*
* ONLY CHILD RECORDS MAY BE ADDED OR EDITED
   CLEAR GETS
* SEE IF KEYS MATCH IN PARENT AND CHILD. IF NOT, TRY FIND ON SECONDARY FILE
   IF REQUEST = "<"
      SELECT B
      GO TOP
   ENDIF
   SELECT B
   IF (EOF() .OR. BOF()).OR.REQUEST<>"A".AND.&DIPARENT<>&DILINK
      STORE &DIPARENT TO TEMP
      SEEK TEMP
   ENDIF
*
*================================START MODS: 3===============================*
*
* DISPLAY CHILD RECORD ONLY IF THERE IS ONE THAT MATCHES PARENT
* FIELDS RETRIEVED ARE FROM THE CHILD (SECONDARY) FILE
   IF .NOT. (EOF() .OR. BOF())
      @ 16,1  SAY "Linked field 1 " GET  Sfield1
      @ 17,1  SAY "Linked field 2 " GET  Sfield2
   ENDIF
* DATE OF LAST UPDATE SHOULD BE ONE OF THE FIELDS (LAST_UPDT)
* BOTH PARENT AND CHILD FILES WILL BE ASSUMED TO CONTAIN LAST_UPDT FIELDS
   @ 18,1 SAY "Last Updated : "
   ?? A->UPDT, B->LAST_UPDT
*==================================END MODS==================================*
*
* DISPLAY VARIABLE DATA IN SCREEN HEADING
   IF DELETE()
      @ 5,1 SAY "* DELETED *"
   ELSE
      @ 5,1 SAY "           "
   ENDIF
* IDENTIFY RECORD
* USE PARENT RECORD RECORD NUMBER
   SELECT A
    @ 5,43 SAY "Record"
    @ 5,50 SAY RECNO()
    @ 5,62 SAY "of"
    @ 5,64 SAY RECCNT
* NOW MAKE SECONDARY FILE ACTIVE, SINCE EDITING OPERATIONS WILL BE ON THIS FILE
   SELECT B
* IF DATAIN FLAG SET, ACTIVATE THE GETS
   IF DATAIN="Y"
      @ 19,72 GET ACTION
      READ
* DATE STAMP CHILD RECORD
      REPLACE LAST_UPDT WITH DATE()
      IF REQUEST="E".OR.ACTION<>"C"
         STORE "N" TO DATAIN
         STORE " " TO REQUEST
         STORE " " TO ACTION
      ENDIF 2
   ELSE
      CLEAR GETS
   ENDIF 1
*
* DISPLAY CONTROL SUBMENU, CURRENT ACTIVE INDEX
   @ 19,0 SAY BLANK
   @ 20,0 SAY "----------------------------------------"
   @ 20,40 SAY "----------------------------------------"
   @ 21,0 CLEAR
   @ 21,2 SAY ;
"<F>ind Record  <A>dd Record   <D>elete/Recall  <E>dit Record   Current Active"
   @ 22,2 SAY ;
"<P>rev Record  <N>ext Record  <M>enu (return)  <K>ey Select    Key:          "
   @ 23,2 SAY ;
"< prev, next linked record >"
* IF INDEX SET NAMED IN LIVE_IX HAS MULTIPLE ENTRIES, EXTRACT FIRST
   IF (","$&LIVE_IX)
      STORE SUBSTR(&LIVE_IX,1,AT(",",&LIVE_IX)-1) TO TEMP
      @ 22,70 SAY TEMP
   ELSE
      @ 22,70 SAY &LIVE_IX
   ENDIF
* GET REQUEST AND FORCE TO UPPER CASE UNLESS ALREADY IN 'A' FOR ADD RECORDS
   IF REQUEST<>"A"
      STORE " " TO REQUEST
      STORE " " TO ACTION
      @ 23,35 SAY "*** NEXT ACTION TO PERFORM " GET REQUEST
      READ
      STORE UPPER(REQUEST) TO REQUEST
   ENDIF
* CLEAR ADD RECORD COMMAND LINE, SUBMENU AREA
   @ 21,0 CLEAR
   DO CASE
* ADD NEW CASE OR EDIT DISPLAYED CASE
      CASE REQUEST="A".OR.REQUEST="E"
* WILL ADD CHILD RECORD. CAN ONLY ADD IF THERE IS AT LEAST ONE PARENT
         IF RECCNT>0
            SELECT B
* IN ADD MODE, APPEND A BLANK RECORD FOR THE DATA AND POSITION TO THAT RECORD
            IF REQUEST="A"
               @ 19,6 SAY "*** PRESS 'C' TO CONTINUE ADDING NEW RECS, ANYTHING;
 ELSE TO QUIT"
               APPEND BLANK
               STORE LINKCNT+1 TO LINKCNT
               GO LINKCNT
* SETUP PARENT RECORD KEY VALUE IN CHILD RECORD
               REPLACE &LINKKEY WITH &DIPARENT
            ELSE
               @ 19,6 SAY "******** PRESS ANY KEY TO FINISH EDIT AND RETURN TO;
 SUBMENU     "
            ENDIF
           @ 21,10 SAY "Enter data at cursor position. Move among fields with"
           @ 22,10 SAY "cursor control keys. Press ENTER to move to next field"
           @ 23,10 SAY "Press ENTER alone to leave field unchanged."
* SET FLAG TO CAUSE NEW DATA TO BE READ
            STORE "Y" TO DATAIN
         ENDIF
* TOGGLE DELETE FLAG. * FUNCTION CHECKS IF RECORD NOW FLAGGED AS DELETED
      CASE REQUEST="D"
         IF DELETE()
            RECALL
         ELSE
            DELETE
         ENDIF
* PREVIOUS RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="P"
         SELECT A
         SKIP -1
* NEXT THREE LINES SECURE THE BACKWARD LOOP
         IF BOF()
            GO BOTTOM
         ENDIF
         SELECT B
* NEXT RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="N"
         SELECT A
         SKIP +1
* NEXT THREE LINES SECURE THE FOWARD LOOP
         IF EOF()
            GO TOP
         ENDIF
         SELECT B
* PREVIOUS CHILD RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="<"
* SAVE CURRENT LOCATION TO SEE IF AT BEGINNING
         STORE RECNO() TO RECNOW
* NEXT THREE LINES SECURE THE BACKWARD LOOP
         IF BOF()
            GO BOTTOM
         ELSE
            SKIP -1
         ENDIF
* IF PARENT AND CHILD DON'T MATCH, OR AT BEGINNING OF CHILD FILE, BACKUP PARENT
         IF &DIPARENT<>&DILINK.OR.BOF()
            SELECT A
            SKIP -1
* NEXT THREE LINES SECURE THE BACKWARD LOOP
            IF BOF()
               GO BOTTOM
            ENDIF
            SELECT B
         ENDIF
* NEXT CHILD RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST=">"
* SAVE CURRENT LOCATION TO SEE IF AT BEGINNING
         STORE RECNO() TO RECNOW
* NEXT THREE LINES SECURE THE FOWARD LOOP
         IF EOF()
            GO TOP
         ELSE
            SKIP +1
         ENDIF
**IF PARENT AND CHILD DON'T MATCH, OR AT END OF CHILD FILE, ADVANCE PARENT
         IF &DIPARENT<>&DILINK
            SELECT A
            SKIP +1
* NEXT THREE LINES SECURE THE FOWARD LOOP
            IF EOF()
               GO TOP
            ENDIF
            SELECT B
         ENDIF
* GET SEARCH VALUE FOR INDEXED SEARCH
      CASE REQUEST="F"
         SELECT A
* USE MACRO DEFINING INDEX ENTRIES FROM DATA FIELDS
         STORE "DI"+LIVE_IX TO IXDEF
         STORE &IXDEF TO SV
         STORE &SV TO SV
         @ 21,1 SAY ;
         "ENTER SEARCH VALUE. VALUE SHOWN IS FROM THE DISPLAYED RECORD. PRESS"
         @ 22,1 SAY "CTRL-Y TO CLEAR " GET SV
         READ
* REMOVE TRAILING BLANKS BEFORE SEARCH
         STORE TRIM(SV) TO SEARCH
* IF RECORD IS NOT FOUND POSITION STAYS AT CURRENT RECORD
* FIND IS IN PARENT FILE
         SELECT A
* NEXT LINE KEEPS TRACK OF CURRENT RECNO() FOR TEST BELOW
         STORE RECNO() TO NOW
         SEEK SEARCH
* NEXT 3 LINES KEEP PRESENT RECORD DISPLAYED IF NO FIND.
         IF EOF()
            GOTO NOW
         ENDIF
         SELECT B
* CHANGE INDEX
      CASE REQUEST="K"
* MUST POINT TO PARENT FILE WHILE INDEX IS CHANGED
         SELECT A
         STORE RECNO() TO RECNOW
         STORE " " TO IXCHOICE
* SETUP MENU OF INDEX NAMES, PROVIDE IF CLAUSE FOR EACH INDEX                *
         @ 21,9 SAY " "
         STORE 1 TO COUNT
         DO WHILE COUNT<=IXCOUNT
            STORE "IX"+CHR(64+COUNT) TO TEMP
            IF IXCOUNT>1
               ?? CHR(64+COUNT)+". "+SUBSTR(&TEMP,1,AT(",",&TEMP)-1)+" "
            ELSE
               ?? CHR(64+COUNT)+". "+&TEMP
            ENDIF
            STORE COUNT+1 TO COUNT
         ENDDO
         @ 22,10 SAY "Press letter of desired key " GET IXCHOICE
         READ
         STORE UPPER(IXCHOICE) TO IXCHOICE
         IF IXCHOICE>="A".AND.IXCHOICE<=CHR(64+IXCOUNT)
            STORE "IX"+IXCHOICE TO LIVE_IX
            STORE &LIVE_IX TO TEMP
            SET INDEX TO &TEMP
         ENDIF
* GOTO THIS RECORD TO ACTIVATE INDEX
         IF RECNOW>0
            GO RECNOW
         ELSE
            GO BOTTOM
         ENDIF
* MAKE SECONDARY FILE ACTIVE AGAIN
         SELECT B
   ENDCASE
ENDDO
* FALL OUT OF DO WHEN 'M' IS REQUEST, RETURN TO SUBSYSTEM'S MENU
CLEAR
RETURN